home *** CD-ROM | disk | FTP | other *** search
/ Suzy B Software 2 / Suzy B Software CD-ROM 2 (1994).iso / unclcarl / gfahelp2 / gfa_demo.gfa (.txt) < prev    next >
GFA-BASIC Atari  |  1995-04-25  |  12KB  |  253 lines
  1. REM  The character  '  is the same as REM
  2. '    See ?
  3. REM  @  is the same as  GOSUB
  4. REM  Place the cursor on >PROCEDURE and hit the HELP key to open it
  5. REM  The character  !  is the same as REM, when placed AFTER a command
  6. ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
  7. '
  8. ' ----------------------------| CL ear S creen
  9. CLS
  10. ' ----------------------------| Get screen resolution
  11. rez%=XBIOS(4)          ! rez%=  0=ST LOW, 1=ST MED,  2=ST HIGH
  12. '                               4=TT MED, 6=TT HIGH, 7=TT LOW
  13. '
  14. ' ----------------------------| If rez%= ST LOW or TT LOW
  15. IF rez%=0 OR rez%=7
  16.   ALERT 3,"|This demo only |works in ST/TT |MED & HIGH rez.",1," Ok ",a#
  17.   END
  18. ENDIF
  19. ' ----------------------------| Determine current path
  20. julie$=CHR$(GEMDOS(25)+65)+":"
  21. ' ----------------------------| GOSUB Save palette routine
  22. @save_palette
  23. ' ----------------------------| GOSUB  load_it  routine
  24. @load_it
  25. ' ----------------------------| GOSUB  dimwit  routine
  26. @dimwit
  27. ' ----------------------------| GOSUB  grace  routine
  28. @grace
  29. ' ----------------------------| SAVE/RESTORE screen colours
  30. > PROCEDURE save_palette
  31.   ' You don't really NEED to erase the palette buffer since you are only
  32.   ' calling this routine once. It's there to remind you that you CANNOT
  33.   ' DIMension an array twice.
  34.   ERASE palette#()
  35.   DIM palette#(15)
  36.   LOCAL i#
  37.   FOR ctr%=0 TO 15
  38.     palette#(ctr%)=XBIOS(7,W:ctr%,W:-1)
  39.   NEXT ctr%
  40. RETURN
  41. > PROCEDURE restore_palette
  42.   LOCAL ctr%
  43.   FOR ctr%=0 TO 15
  44.     SETCOLOR ctr%,palette#(ctr%)
  45.   NEXT ctr%
  46. RETURN
  47. ' ----------------------------| RSC file addresses (from .LST file)
  48. > PROCEDURE definitions
  49.   ' These are the address numbers for the objects in the .RSC file
  50.   LET menutree&=0 !RSC_TREE
  51.   LET xyzzymen&=16 !Obj in #0
  52.   LET quitmenu&=18 !Obj in #0
  53.   LET panelone&=1 !RSC_TREE
  54.   LET radioa&=3 !Obj in #1
  55.   LET radiob&=4 !Obj in #1
  56.   LET radioc&=5 !Obj in #1
  57.   LET okaybutt&=11 !Obj in #1
  58.   LET canclbut&=12 !Obj in #1
  59.   LET edittext&=17 !Obj in #1
  60.   LET dialog01&=2 !RSC_TREE
  61.   LET about&=7 !Obj in #0
  62. RETURN
  63. ' ----------------------------| Load RSC file
  64. > PROCEDURE load_it
  65.   IF RSRC_LOAD(julie$+"rsc_demo.rsc")   !Resource load
  66.     ~RSRC_GADDR(0,0,menu_adr%)          !Assign Variables to menu_adr%
  67.     '             ^0 is the address for the menu-bar in PROCEDURE definitions
  68.     ~MENU_BAR(menu_adr%,1)              !Display menu-bar
  69.   ELSE
  70.     ALERT 3,"|Resource file |NOT found..! ",1," Bye ",a#
  71.     @restore_palette                    !Restore screen colours
  72.     CLS                                 !Clear screen
  73.     END
  74.   ENDIF
  75. RETURN
  76. ' ----------------------------| DIMension menu message buffer
  77. > PROCEDURE dimwit
  78.   ' You don't really NEED to erase the message buffer since you are only
  79.   ' calling this routine once. It's there to remind you that you CANNOT
  80.   ' DIMension an array twice.
  81.   ERASE message_buffer%()
  82.   DIM message_buffer%(3)
  83.   mes_adr%=V:message_buffer%(0)
  84.   ABSOLUTE mes_type&,mes_adr%
  85.   ABSOLUTE m_title&,mes_adr%+6
  86.   ABSOLUTE m_enter&,mes_adr%+8
  87. RETURN
  88. ' ----------------------------| Clear screen below menu
  89. > PROCEDURE fill_it
  90.   ' 1280 by 1280 is the MAXIMUM screen width and height currently available
  91.   ' for STs and TTs. This number allows this 1 call to work in ALL resolutions.
  92.   ~FORM_DIAL(3,0,0,0,0,0,0,1280,1280)
  93. RETURN
  94. ' ----------------------------| Disable ACCessories
  95. > PROCEDURE disable_accs
  96.   ' Most DAs don't clean up after themselves. You can either use this
  97.   ' routine to disable them or open a window and use RC_INTERSECT to track
  98.   ' them. THIS is the easy way.
  99.   FOR xtc#=9 TO 15
  100.     ~MENU_IENABLE(menu_adr%,xtc#,1)
  101.     '                           ^ 0 disables them, 1 reenables them
  102.   NEXT xtc#
  103. RETURN
  104. ' ----------------------------| MENU BAR
  105. > PROCEDURE grace
  106.   @disable_accs       ! Disable ACCS
  107.   @fill_it            ! Clear screen below menu
  108.   ' ---------------------|* MENU LOOP
  109.   REPEAT
  110.     ON ERROR GOSUB oops
  111.   hairy:
  112.     ~EVNT_MULTI(&X110000,0,0,0,0,0,0,0,0,0,0,0,0,0,mes_adr%,500)
  113.     IF mes_type&=10                     !If a menu entry is chosen
  114.       IF obj_nr%<>m_enter&              !Object # <> menu entry
  115.         obj_nr%=m_enter&                !Object # = menu entry
  116.         ' ---------------------------------------------------------------------|
  117.         IF obj_nr%=7                    !If the menu object is chosen
  118.           '                             !(the number corresponds to the number
  119.           '                             !in the DEFINITIONS)
  120.           @normal_it                    !Unselect menu bar choice
  121.           @about_foolish                !About menu
  122.           mes_type&=0                   !Erase choice from buffer
  123.           ~RSRC_GADDR(0,0,menu_adr%)    !Return menu bar
  124.           @fill_it                      !Clear screen below menu
  125.           @shrinkbox
  126.         ENDIF
  127.         ' ---------------------------------------------------------------------|
  128.         IF obj_nr%=18                   !Quit Menu
  129.           @normal_it
  130.           GOTO imdone
  131.         ENDIF
  132.         ' ---------------------------------------------------------------------|
  133.         IF obj_nr%=16                   !XYZZY
  134.           @normal_it
  135.           @growbox
  136.           @panel_uno
  137.           mes_type&=0
  138.           ~RSRC_GADDR(0,0,menu_adr%)
  139.           @fill_it
  140.           @shrinkbox
  141.         ENDIF
  142.         ' ---------------------------------------------------------------------|
  143.       ENDIF
  144.     ELSE
  145.       GOTO hairy
  146.     ENDIF
  147.   UNTIL MOUSEK=4  !No escape from THIS loop <grin>
  148. imdone:
  149.   ~MENU_BAR(menu_adr%,0)
  150.   ~RSRC_FREE()
  151.   @restore_palette
  152.   CLS
  153.   @fill_it
  154.   END
  155. RETURN
  156. ' ----------------------------| Return MENU to normal
  157. > PROCEDURE normal_it
  158.   ~MENU_TNORMAL(menu_adr%,m_title&,1)    !Return menu to normal
  159.   obj_nr%=0                              !no object selected for buffer
  160. RETURN
  161. ' ----------------------------| XYZZY Panel
  162. > PROCEDURE panel_uno
  163. merrill:
  164.   @listing                                    !Clear\ReDIMension radios
  165.   ' ---------------------------------------------------------------------------
  166.   ~RSRC_GADDR(0,1,panel%)                     !Return RSC address for panel
  167.   '             ^ 1 is the address in DEFINITIONS for the panel
  168.   ' ---------------------------------------------------------------------------
  169.   ~FORM_CENTER(panel%,x%,y%,w%,h%)            !Center it on screen
  170.   ' ---------------------------------------------------------------------------
  171.   CHAR{{OB_SPEC(panel%,17)}}="      "         !Clear EDIT line
  172.   '                    ^ 17 is the address of EDIT in DEFINTIONS
  173.   '
  174.   CHAR{{OB_SPEC(panel%,17)}}=""               !Move cursor to left
  175.   ' ---------------------------------------------------------------------------
  176.   ~OBJC_DRAW(panel%,0,5,x%,y%,w%,h%)          !Draw the panel
  177.   '                   ^ 5 means draw EVERYTHING in box, the lower the
  178.   '                     number, the less of the boxes contents appear
  179.   '                     on the screen
  180.   ' ---------------------------------------------------------------------------
  181.   ex_obj%=FORM_DO(panel%,0)                   !Wait for exit object to be
  182.   '                                            selected
  183.   ' ---------------------------------------------------------------------------
  184.   ~OBJC_CHANGE(panel%,12,0,x%,y%,w%,h%,0,1)  !Reset Cancel Button
  185.   '                   ^Cancel Button
  186.   ' ---------------------------------------------------------------------------
  187.   IF ex_obj%=12        !If the exit object is the CANCEL button
  188.     ALERT 1,"|You have selected |Cancel...",1," Boof! ",lk%
  189.     GOTO jerky_joel
  190.   ENDIF
  191.   ' ---------------------------------------------------------------------------
  192.   edit$=CHAR{{OB_SPEC(panel%,17)}}          !edit$=What you type in
  193.   ' ^ TEXT you have typed in ^EDIT line
  194.   ' ---------------------------------------------------------------------------
  195.   @check_radios                             !Check if RADIO BUTTON was selected
  196.   ' ---------------------------------------------------------------------------
  197.   IF edit$>""
  198.     ALERT 1,"|You have entered |"+edit$+"|on the EDIT line. ",1," Ok ",a#
  199.   ENDIF
  200.   GOTO merrill
  201. jerky_joel:
  202. RETURN
  203. ' ----------------------------| "About" panel
  204. > PROCEDURE about_foolish
  205.   ~RSRC_GADDR(0,2,dialog_one%)              !Return RSC address for dialog panel
  206.   ~FORM_CENTER(dialog_one%,x%,y%,w%,h%)     !Center it on the screen
  207.   @growbox
  208.   ~OBJC_DRAW(dialog_one%,0,5,x%,y%,w%,h%)   !Draw it
  209.   ex_obj%=FORM_DO(dialog_one%,0)            !Wait for exit object to be chosen
  210.   '                                          sort of like key=INP(2)
  211. RETURN
  212. ' ----------------------------| End on error
  213. > PROCEDURE oops
  214.   ~MENU_BAR(menu_adr%,0)          !Return menu bar address
  215.   ~RSRC_FREE()                    !Return memory block used by RSC load
  216.   @restore_palette                !Restore original screen colours
  217.   ALERT 2,"|Oops...must be an error |somewhere...",1," Bye ",aa#
  218.   END
  219. RETURN
  220. ' ----------------------------| Graphic "zoomboxes"
  221. > PROCEDURE growbox
  222.   ~GRAF_GROWBOX(0,0,0,0,x%,y%,w%,h%)
  223. RETURN
  224. > PROCEDURE shrinkbox
  225.   ~GRAF_SHRINKBOX(0,0,0,0,x%,y%,w%,h%)
  226. RETURN
  227. ' ----------------------------| RADIO buttons
  228. > PROCEDURE listing
  229.   ERASE ra%()
  230.   DIM ra%(3)
  231.   LET ra%(1)=3   !Radio Button A
  232.   LET ra%(2)=4   !Radio Button B
  233.   LET ra%(3)=5   !Radio Button C
  234. RETURN
  235. > PROCEDURE check_radios
  236.   FOR i%=1 TO 3
  237.     IF BTST(OB_STATE(panel%,ra%(i%)),0)    !If button is chosen
  238.       radio%=ra%(i%)
  239.     ENDIF
  240.   NEXT i%
  241.   IF radio%<>0 AND radio%=3
  242.     rad$="A"
  243.   ELSE IF radio%<>0 AND radio%=4
  244.     rad$="B"
  245.   ELSE IF radio%<>0 AND radio%=5
  246.     rad$="C"
  247.   ELSE
  248.     rad$="NONE"
  249.   ENDIF
  250.   ALERT 1,"|You have chosen |Radio Button "+rad$+" ",1," So ? ",a#
  251. RETURN
  252. ' ----------------------------|
  253.